perm filename COMPLR.BUG[MLI,LSP] blob sn#026346 filedate 1975-06-03 generic text, type T, neo UTF8
(DEFPROP STORE_PROP
         (LAMBDA (ATM VAL IND)
          (PROG (_G)
                (SETQ _G (GET (QUOTE PROPERTIES) (QUOTE ARRAY)))
                (STORE (_G (CADDR ATM)) (APPEND (LIST IND VAL) (_G (CADDR ATM))))))
         EXPR)
(DEFPROP COMPUTE_PAST_DUE
         (LAMBDA (NAME)
          (PROG (PAST_DUE)
                (PRINTSTRTTY (CAT (QUOTE "Is there any past due for ") (CAT NAME (QUOTE "?"))))
                (COND ((EQ (READ) (QUOTE no)) (RETURN 0)))
                (SETQ PAST_DUE 0)
                (PRINTSTRTTY (QUOTE "Do you want to itemize the amounts month by month?"))
                (COND ((EQ (READ) (QUOTE yes))
                       (PROG (MONTH)
                             (TERPRI (PRINTSTR (TERPRI (QUOTE "Past due:"))))
                             (PRINTSTRTTY
                              (QUOTE
                               "Type the month, followed by a carriage return.
Type done when there are no more months."))
                             (PROG (&V)
                              LOOP (COND ((NOT (EQ (SETQ MONTH (READ)) (QUOTE done)))
                                          (SETQ &V
                                                (PROG (AMOUNT)
                                                      (PRINTSTRTTY (QUOTE "Amount ="))
                                                      (PRINTSTR
                                                       (CHOP (SPACE (CAT (QUOTE "     ") MONTH))
                                                             (DOLLARS (SETQ AMOUNT (READ)))))
                                                      (SETQ PAST_DUE (*PLUS PAST_DUE AMOUNT))
                                                      (PRINTSTRTTY (QUOTE "Next month (or done) =")))))
                                         (T (RETURN &V)))
                                   (GO LOOP))))
                      (T (PROG NIL
                               (PRINTSTRTTY (QUOTE "Amount past due ="))
                               (TERPRI
                                (PRINTSTR
                                 (TERPRI
                                  (CHOP (SPACE (QUOTE "Past due")) (DOLLARS (SETQ PAST_DUE (READ))))))))))
                (RETURN PAST_DUE)))
         EXPR)